home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr34 / tarchiv.zip / TOOLBOX.PAS < prev   
Pascal/Delphi Source File  |  1995-01-27  |  2KB  |  107 lines

  1. Unit ToolBox;
  2.  
  3. Interface
  4.  
  5. Uses Dos,Crt;
  6.  
  7. Function  WildMatch (Name,WName : NameStr; Ext, WExt : ExtStr) : Boolean;
  8. Function  FileExists (Filename : String) : Boolean;
  9. Function  Upper (Text : String) : String;
  10. Procedure Commas (Var Text : String);
  11. Function  TimeString (LTime : Longint) : String;
  12.  
  13. Implementation
  14.  
  15. { Matches a filename with a wildcard }
  16. { }
  17. Function WildMatch (Name,WName : NameStr; Ext, WExt : ExtStr) : Boolean;
  18. Var
  19.  Match : Boolean;
  20.  Star  : Boolean;
  21.  L     : Byte;
  22. Begin
  23.  Match := True;
  24.  
  25.  Star  := False;
  26.  L := 1;
  27.  While (L<=Length(WName)) AND (L<=Length(Name)) Do Begin
  28.   Star  := Star OR (WName[L]='*');
  29.   Match := Match AND (Star OR (WName[L]='?') OR (WName[L]=Name[L]));
  30.   INC(L);
  31.  End;
  32.  If NOT Star Then Match := Match AND (WName[0]=Name[0]);
  33.  IF Match Then Begin
  34.   Star  := False;
  35.   L := 1;
  36.   While (L<=Length(WExt)) AND (L<=Length(Ext)) Do Begin
  37.    Star  := Star OR (WExt[L]='*');
  38.    Match := Match AND (Star OR (WExt[L]='?') OR (WExt[L]=Ext[L]));
  39.    INC(L);
  40.   End;
  41.   If NOT Star Then Match := Match AND (WExt[0]=Ext[0]);
  42.  End;
  43.  
  44.  WildMatch := Match;
  45. End;
  46.  
  47. { Converts a string into uppercase }
  48. { }
  49. Function Upper (Text : String) : String;
  50. Var
  51.  L : Byte;
  52. Begin
  53.  If Length(Text)>0 Then For L:=1 To Length(Text) Do Text[L] := UpCase(Text[L]);
  54.  Upper := Text;
  55. End;
  56.  
  57. { Insert commas every three digits from the left }
  58. { }
  59. Procedure Commas (Var Text : String);
  60. Var
  61.   Count : Byte;
  62. Begin
  63.  { Remove leading blanks }
  64.  While (Length(Text)>0) And (Text[1]=' ') Do Delete (Text,1,1);
  65.  { Insert commas }
  66.  Count := Length (Text)+1;
  67.  While Count>4 Do Begin
  68.   Dec (Count,3);
  69.   Insert (',',Text,Count);
  70.  End;
  71. End;
  72.  
  73. { Converts a time in packed DOS format into a string }
  74. { }
  75. Function TimeString (LTime : Longint) : String;
  76. Var
  77.  ATime : DateTime;
  78.  { }
  79.  Function LeadZero(Number : Word):String;
  80.  Var
  81.   S : String;
  82.  Begin
  83.   Str(Number:2,S);
  84.   If S[1]=' ' Then S[1]:='0';
  85.   LeadZero := S;
  86.  End;
  87.  { }
  88. Begin
  89.  UnpackTime (LTime,ATime);
  90.  TimeString := LeadZero(ATime.Day)+'/'+LeadZero(ATime.Month)+'/'+LeadZero(ATime.Year MOD 100)+' '+
  91.                LeadZero(ATime.Hour)+':'+LeadZero(ATime.Min)+':'+LeadZero(ATime.Sec);
  92. End;
  93.  
  94. Function FileExists (Filename : String) : Boolean;
  95. Var
  96.  S : SearchRec;
  97. Begin
  98.  Dos.FindFirst(Filename,Archive,S);
  99.  FileExists := ((DosError=0) AND (S.Size>0));
  100.  DosError := 0;
  101. End;
  102.  
  103. { === }
  104.  
  105. Begin
  106. End.
  107.